home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / db3tech.arc / NEWHEAD.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-11-01  |  6.6 KB  |  209 lines
  1. PROGRAM Newhead (input,output);
  2.  
  3. {This program restores corrupted dBASE III file headers by
  4. writing a new header on top of the old one, and supplying a new
  5. record count based on user input.  It is based on NEWHEAD.BAS by
  6. Luis Castro.}
  7.  
  8.  
  9. TYPE
  10.  
  11. {These type definitions map out the header structure.  The
  12. information is taken from the Advanced Programmer's Guide, page
  13. 295.}
  14.  
  15.     field_desc  =  RECORD
  16.                       fld_name : array [1..11] of char;
  17.                       fld_type : char;
  18.                       fld_addr : array [1..4] of byte;
  19.                       fld_len  : byte;
  20.                       fld_dec  : byte;
  21.                       fld_res  : array [1..14] of char;
  22.                    END;
  23.  
  24.     header      =  RECORD
  25.                       hdr_start : array [1..4] of byte;
  26.                       numrecs   : array [1..4] of byte;
  27.                       hdr_len   : integer;
  28.                       rec_len   : integer;
  29.                       hdr_res   : array [1..20] of char;
  30.                       fields    : array [1..128] of field_desc;
  31.                    END;
  32.  
  33. VAR
  34.    newfile, oldfile   :  file of header;
  35.    file1, file2       :  string[12];
  36.    counter            :  integer;
  37.    num_recs           :  real;
  38.    fldtotal           :  integer;
  39.    i                  :  integer;
  40.    j                  :  integer;
  41.    new_struc          :  header;
  42.    old_struc          :  header;
  43.    file_found         :  boolean;
  44.  
  45. FUNCTION Power (x : real; y : integer) : real;
  46.  
  47. {This function does exponentiation.  It makes up for the absence
  48. of an exponentiation symbol like "^" or "**" in Pascal.  It is
  49. invoked by the command Power(x,y), which is the equivalent of
  50. x^y.}
  51.  
  52.    BEGIN
  53.       Power := exp(y*ln(x));
  54.    END;
  55.  
  56.  
  57.  
  58. BEGIN
  59.  
  60.    Writeln;
  61.    Writeln ('*** ALL FILENAMES MUST INCLUDE EXTENSIONS ***');
  62.  
  63.    Counter := 1;
  64.    REPEAT
  65.        {Get name of new structure file from user.}
  66.        REPEAT
  67.        Writeln;
  68.        Write ('Enter new structure FILENAME.EXT:  ');
  69.        Readln (file1);
  70.        If Pos('.',file1) = 0 then
  71.           BEGIN
  72.             Writeln;
  73.             Writeln(Chr(7),'Filename Must Include Extension');
  74.           END;
  75.      UNTIL Pos('.',file1) <> 0;
  76.  
  77.      {Open new structure file.}
  78.      Assign (newfile,file1);
  79.      {$I-} Reset (newfile) {$I+};
  80.      File_found := (IOresult = 0);
  81.      If NOT File_found then
  82.         BEGIN
  83.           Writeln;
  84.           Writeln(Chr(7),'File ',file1,' not found');
  85.           Counter := Counter + 1;
  86.         END;
  87.    UNTIL File_found OR (Counter = 4);
  88.  
  89.    If File_found then
  90.      BEGIN
  91.        Counter := 1;
  92.        REPEAT
  93.          {Get name of corrupted file.}
  94.          REPEAT
  95.            Writeln;
  96.            Write ('Enter old FILENAME.EXT:  ');
  97.            Readln (file2);
  98.            If Pos('.',file2) = 0 then
  99.               BEGIN
  100.                 Writeln;
  101.                 Writeln(Chr(7),'Filename Must Include Extension');
  102.               END;
  103.            If file2 = file1 then
  104.               BEGIN
  105.                 Writeln;
  106.                 Writeln(Chr(7),
  107.                   'Old file and new file cannot be the same file');
  108.                 file2 := 'file';
  109.               END;
  110.          UNTIL Pos('.',file2) <> 0;
  111.  
  112.          {Open old structure file.}
  113.          Assign (oldfile,file2);
  114.          {$I-} Reset (oldfile) {$I+};
  115.          File_found := (IOresult = 0);
  116.          If NOT File_found then
  117.             BEGIN
  118.               Writeln;
  119.               Writeln(Chr(7),'File ',file2,' not found');
  120.               Counter := Counter + 1;
  121.             END;
  122.        UNTIL File_found OR (Counter = 4);
  123.  
  124.        If File_found then
  125.          BEGIN
  126.            {Read files into memory.}
  127.            Read (newfile,new_struc);
  128.            Read (oldfile,old_struc);
  129.            Reset (oldfile);
  130.            {Convert number of records from four-byte integer
  131.             to real number.}
  132.            Num_recs := old_struc.numrecs[4]*power(2,24);
  133.            Num_recs := num_recs + old_struc.numrecs[3]*power(2,16);
  134.            Num_recs := num_recs + old_struc.numrecs[2]*power(2,8);
  135.            Num_recs := num_recs + old_struc.numrecs[1];
  136.            Writeln;
  137.            {Get desired number of records.}
  138.            Writeln ('Number of records:  ',num_recs:0:0);
  139.            REPEAT
  140.              Write ('        Change to:  ');
  141.              Readln (num_recs);
  142.              If (num_recs < 0.0) OR (num_recs > 1E+9) then
  143.                 BEGIN
  144.                   Writeln;
  145.                   Writeln(Chr(7),'Number of records out of range');
  146.                 END;
  147.            UNTIL (num_recs >= 0.0) AND (num_recs <= 1E+9);
  148.  
  149.    {Compute the number of fields from the total header length.
  150.     It equals the total length minus 34 bytes (the number of
  151.     bytes not devoted to field descriptor information),
  152.     divided by 32, the number of bytes per field descriptor.}
  153.  
  154.            Fldtotal := (new_struc.hdr_len - 34) DIV 32;
  155.  
  156.           {Move information from new structure into old structure.}
  157.            With old_struc DO
  158.              BEGIN
  159.                hdr_start := new_struc.hdr_start;
  160.                j := 4;
  161.                i := 24;
  162.  
  163.        {The following lines of code convert the number of records
  164.         from a four-byte real number to a four-byte integer, by
  165.         dividing by 2^24, dividing the remainder by 2^16, dividing
  166.         this remainder by 2^8, until the quotient is 0.  This allows
  167.         for the full number of records permitted by dBASE III.}
  168.  
  169.                REPEAT
  170.                   numrecs[j] := trunc(num_recs/power(2,i));
  171.                   num_recs := num_recs - (int(num_recs/power(2,i))*power(2,i));
  172.                   j := j - 1;
  173.                   i := i - 8;
  174.                UNTIL i = 0;
  175.                numrecs[j] := trunc(num_recs);
  176.  
  177.                hdr_len := new_struc.hdr_len;
  178.                rec_len := new_struc.rec_len;
  179.                hdr_res := new_struc.hdr_res;
  180.  
  181.                {Move field descriptor arrays.}
  182.                For i:= 1 to (fldtotal) do
  183.                    fields[i] := new_struc.fields[i];
  184.              END;
  185.  
  186.      {Structure ends with carriage return, 0 string terminator,
  187.       and 20H deletion flag for first record (marking it as
  188.       .NOT. DELETED()  ).}
  189.  
  190.            With old_struc.fields[fldtotal+1] do
  191.              BEGIN
  192.                fld_name[1] := chr(13);
  193.                fld_name[2] := chr(0);
  194.                fld_name[3] := ' ';
  195.              END;
  196.  
  197.            {Save restored file to disk.}
  198.            Write (oldfile,old_struc);
  199.  
  200.            {Close files and END.}
  201.            Close (oldfile);
  202.            Close (newfile);
  203.  
  204.          END;
  205.      END;
  206.  
  207. END.
  208.  
  209.